;;************************************************************************
;; scatter.lsp 
;; contains code for adding curves to scatterplot
;; copyright (c) 1991-98 by Forrest W. Young
;;Contains additions for regression color lines and new starting values for kernel method PV 2003
;;************************************************************************
(defmeth scatterplot-proto :make-scatterplot-curves ()

  (send scatterplot-proto :add-slot 'show-density)

  (send self :add-slot 'add-linear)
  (send self :add-slot 'add-quantile)
  (send self :add-slot 'add-normal)
  (send self :add-slot 'add-residual)
  (send self :add-slot 'regvalues-list)
 ;regmeanline regline regresiduals regcontour lsmt
  (send self :add-slot 'regcolors-list 
        (list 'orange 'blue 'blue 'dark-red 'red))
  (send self :add-slot 'add-regresiduals?)
  (send self :add-slot 'add-regcontour?)
  (send self :add-slot 'add-regline?)

  (send self :add-slot 'add-regcolorlines?);PV
  (send self :add-slot 'add-hilitedlines?)
  (send self :add-slot 'add-lowcolorlines?)


  (send self :add-slot 'add-regmeanline?)
  (send self :add-slot 'add-kernel-line)
  (send self :add-slot 'add-lowess)
  (send self :add-slot 'add-lsmt?)
  

  (send self :add-slot 'norm-contour-xy)
  (send self :add-slot 'norm-contour-values)
  (send self :add-slot 'quantour-xy)
  (send self :add-slot 'quantour-value 10)
  (send self :add-slot 'lowess-fraction .3)
  (send self :add-slot 'dens-dialog)
  (send self :add-slot 'kernel-line-type 0)
  (send self :add-slot 'kernel-width-value 1)

  (send self :add-slot 'pca-args)
  (send self :add-slot 'ks-args)
  (send self :add-slot 'low-args)
  (send self :add-slot 'norm-args)
  (send self :add-slot 'quan-args)
  (send self :add-slot 'res-args)
  (send self :add-slot 'reg-args)
  )

;;methods for regcolor PV
  (defmeth scatterplot-proto :add-regcolorlines? (&optional (logical nil set))
    (if set (setf (slot-value 'add-regcolorlines?) logical))
    (slot-value 'add-regcolorlines?))
  (defmeth scatterplot-proto :switch-add-regcolor ()
    (send self :add-regcolorlines? (not (send self :add-regcolorlines?)))
    (if (send self :add-regcolorlines?)
        (send self :add-regression-color-lines)
        (send self :clear-curves)))



;;methods for color lowess PV
  (defmeth scatterplot-proto :add-lowcolorlines? (&optional (logical nil set))
    (if set (setf (slot-value 'add-lowcolorlines?) logical))
    (slot-value 'add-lowcolorlines?))

  (defmeth scatterplot-proto :switch-add-lowcolor ()
    (send self :add-lowcolorlines? (not (send self :add-lowcolorlines?)))
    (if (send self :add-lowcolorlines?)
        (send self :add-lowess-color-lines)
        (send self :clear-curves)))


;;methods for hilited regression lines PV
  (defmeth scatterplot-proto :add-hilitedlines? (&optional (logical nil set))
    (if set (setf (slot-value 'add-hilitedlines?) logical))
    (slot-value 'add-hilitedlines?))
  (defmeth scatterplot-proto :switch-add-hilited-regression ()
    (send self :add-hilitedlines? (not (send self :add-hilitedlines?)))
    (if (send self :add-hilitedlines?)
        (send self :activate-hilited-lines)
        (send self :deactive-hilited-lines)))



  (defmeth scatterplot-proto :add-lsmt? (&optional (logical nil set))
    (if set (setf (slot-value 'add-lsmt?) logical))
    (slot-value 'add-lsmt?))
  (defmeth scatterplot-proto :kernel-line-type (&optional (value nil set))
    (if set (setf (slot-value 'kernel-line-type) value))
    (slot-value 'kernel-line-type))
  (defmeth scatterplot-proto :kernel-width-value (&optional (value nil set))
    (if set (setf (slot-value 'kernel-width-value) value))
    (slot-value 'kernel-width-value))
  (defmeth scatterplot-proto :show-density (&optional (logical nil set))
    (if set (setf (slot-value 'show-density) logical))
    (slot-value 'show-density))
  (defmeth scatterplot-proto :add-quantile (&optional (logical nil set))
    (if set (setf (slot-value 'add-quantile) logical))
    (slot-value 'add-quantile))
  (defmeth scatterplot-proto :quantour-xy (&optional (list nil set))
    (if set (setf (slot-value 'quantour-xy) list))
    (slot-value 'quantour-xy))
  (defmeth scatterplot-proto :quantour-value (&optional (number nil set))
    (if set (setf (slot-value 'quantour-value) number))
    (slot-value 'quantour-value))
  (defmeth scatterplot-proto :add-normal (&optional (logical nil set))
    (if set (setf (slot-value 'add-normal) logical))
    (slot-value 'add-normal))
  (defmeth scatterplot-proto :add-residual (&optional (logical nil set))
    (if set (setf (slot-value 'add-residual) logical))
    (slot-value 'add-residual))
  (defmeth scatterplot-proto :regvalues-list (&optional (list nil set))
    (if set (setf (slot-value 'regvalues-list) list))
    (slot-value 'regvalues-list))
  (defmeth scatterplot-proto :regcolors-list (&optional (list nil set))
    (if set (setf (slot-value 'regcolors-list) list))
    (slot-value 'regcolors-list))
  (defmeth scatterplot-proto :add-regresiduals? (&optional (logical nil set))
    (if set (setf (slot-value 'add-regresiduals?) logical))
    (slot-value 'add-regresiduals?))
  (defmeth scatterplot-proto :add-regcontour? (&optional (logical nil set))
    (if set (setf (slot-value 'add-regcontour?) logical))
    (slot-value 'add-regcontour?))
  (defmeth scatterplot-proto :add-regline? (&optional (logical nil set))
    (if set (setf (slot-value 'add-regline?) logical))
    (slot-value 'add-regline?))
  (defmeth scatterplot-proto :add-regmeanline? (&optional (logical nil set))
    (if set (setf (slot-value 'add-regmeanline?) logical))
    (slot-value 'add-regmeanline?))
 
  (defmeth scatterplot-proto :norm-contour-xy (&optional (list nil set))
    (if set (setf (slot-value 'norm-contour-xy) list))
    (slot-value 'norm-contour-xy))
  (defmeth scatterplot-proto :norm-contour-values (&optional (list nil set))
    (if set (setf (slot-value 'norm-contour-values) list))
    (slot-value 'norm-contour-values))
  (defmeth scatterplot-proto :add-linear (&optional (logical nil set))
    (if set (setf (slot-value 'add-linear) logical))
    (slot-value 'add-linear))
  (defmeth scatterplot-proto :add-kernel-line (&optional (logical nil set))
    (if set (setf (slot-value 'add-kernel-line) logical))
    (slot-value 'add-kernel-line))
  (defmeth scatterplot-proto :add-lowess (&optional (logical nil set))
    (if set (setf (slot-value 'add-lowess) logical))
    (slot-value 'add-lowess))
  (defmeth scatterplot-proto :lowess-fraction (&optional (list nil set))
    (if set (setf (slot-value 'lowess-fraction) list))
    (slot-value 'lowess-fraction))
  (defmeth scatterplot-proto :pca-args (&optional (list nil set))
    (if set (setf (slot-value 'pca-args) list))
    (slot-value 'pca-args))
  (defmeth scatterplot-proto :ks-args (&optional (list nil set))
    (if set (setf (slot-value 'ks-args) list))
    (slot-value 'ks-args))
  (defmeth scatterplot-proto :low-args (&optional (list nil set))
    (if set (setf (slot-value 'low-args) list))
    (slot-value 'low-args))
  (defmeth scatterplot-proto :norm-args (&optional (list nil set))
    (if set (setf (slot-value 'norm-args) list))
    (slot-value 'norm-args))
  (defmeth scatterplot-proto :quan-args (&optional (list nil set))
    (if set (setf (slot-value 'quan-args) list))
    (slot-value 'quan-args))
  (defmeth scatterplot-proto :res-args (&optional (list nil set))
    (if set (setf (slot-value 'res-args) list))
    (slot-value 'res-args))
  (defmeth scatterplot-proto :reg-args (&optional (list nil set))
    (if set (setf (slot-value 'reg-args) list))
    (slot-value 'reg-args))
  

  (defmeth scatterplot-proto :switch-add-quantile ()
    (send self :add-quantile (not (send self :add-quantile)))
    (if (send self :add-quantile)
        (send self :add-quantours)
        (send self :clear-curves)))

  (defmeth scatterplot-proto :switch-add-normal 
    (&key (contour-values (list 1 2 3)) (axes t) reg)
    (send self :add-normal (not (send self :add-normal)))
    (if (send self :add-normal)
        (send self :add-normal-contours 
              :contour-values contour-values :axes axes :reg reg)
        (send self :clear-curves)))

 

  (defmeth scatterplot-proto :switch-add-residuals 
    (&key (contour-values (list 1 2 3)) (axes t) reg)
    (send self :add-residual (not (send self :add-residual)))
    (if (send self :add-residual)
        (send self :add-residuals)
        (send self :clear-curves)))

(defmeth scatterplot-proto :switch-add-regresiduals ()
  (send self :add-regresiduals? (not (send self :add-regresiduals?)))
  (unless (send self :add-regresiduals?) (send self :clear-curves))
  (send self :add-reglines 
        :residuals (send self :add-regresiduals?)
        :contours (send self :add-regcontours?)))
     
(defmeth scatterplot-proto :switch-add-regcontours ()
  (send self :add-regcontours? (not (send self :add-regcontours?)))
  (unless (send self :add-regcontours?) (send self :clear-curves))
  (send self :add-reglines 
        :residuals (send self :add-regresiduals?)
        :contours (send self :add-regcontours?)))

  
  (defmeth scatterplot-proto :switch-add-kernel-line (&key (color 'magenta))
    (send self :add-kernel-line (not (send self :add-kernel-line)))
    (if (send self :add-kernel-line)
        (send self :add-kernel-smooth :color color)
        (send self :clear-curves)))

  (defmeth scatterplot-proto :switch-add-lowess ()
    (send self :add-lowess (not (send self :add-lowess)))
    (if (send self :add-lowess)
        (send self :add-lowess-line)
        (send self :clear-curves)))

  (defmeth scatterplot-proto :switch-add-linear (&key (width 1) (color 'blue))
    (send self :add-linear (not (send self :add-linear)))
    (if (send self :add-linear)
        (send self :add-principal-component :color color :width width)
        (send self :clear-curves)))

  (defmeth scatterplot-proto :redraw-curves ()
    (send self :quantour-xy nil)
    (send self :norm-contour-xy nil)
    (send self :clear-curves))
#|
  (defmeth scatterplot-proto :clear-curves ()
    (send self :start-buffering)
    (send self :clear-lines)
    (send self :redraw)
    (when (send self :add-linear)  
          (apply #'send self :add-principal-component (send self :pca-args)))
    (when (send self :add-kernel-line) 
          (apply #'send self :add-kernel-smooth (send self :ks-args)))
    (when (send self :add-lowess)  
          (apply #'send self :add-lowess-line (send self :low-args)))
    (when (send self :add-normal)  
          (apply #'send self :add-normal-contours (send self :norm-args)))
    (when (send self :add-quantile)
          (apply #'send self :add-quantours (send self :quan-args)))
    (when (send self :add-residual)
          (apply #'send self :add-residuals (send self :res-args)))
    (when (send self :add-reglines?)
          (apply #'send self :add-reglines (send self :reg-args)))
    (when (send self :add-lsmt?)
          (apply #'send self :add-lsmt))
    (send self :draw-legends)
    (send self :redraw)
    (send self :buffer-to-screen))
  |#

 (defmeth scatterplot-proto :choose-density ()            
    (cond ((not (send self :slot-value 'dens-dialog))
     (let* ((graph self)
            (den-fun-state (list nil nil))
            (smooth-fun-state (list nil nil nil))
            (contours (send choice-item-proto :new
              (list "No Contours" "Normal Contours" "Quantile Contours (Use Slider)")
                :value 0 
                :action #'(lambda () (send graph :add-contours))))

            (quantour (send toggle-item-proto :new "Quantile Contours (Use Slider)"
                            :value (select den-fun-state 1)
                            :action #'(lambda () 
                                        (send graph :do-addquant))))
            (qt-slider-text (send text-item-proto :new "Quantile Value:"))
            (qt-slider-value (send text-item-proto :new " 1.00"))
            (qt-slider (send sequence-scroll-item-proto :new
               (combine (rseq .50 .85 8) 
                        (list .875 .90 .925 .95 .975 .99 1.0 nil))
                :action #'(lambda (value)
                     (if value
                         (send self :quantour-value value)
                         (send self :quantour-value 10))
                     (send self :redraw-curves))
                :value 15 :page-increment 1  :text-item qt-slider-value))
            (normal (send toggle-item-proto :new "Normal Contours"
                            :value (select den-fun-state 1)
                            :action #'(lambda () 
                                        (send graph :do-addnorm))))
            (kernel-line-type (send choice-item-proto :new
                (list "Bisquare Kernel" "Gaussian Kernel" 
                      "Triangular Kernel" "Uniform Kernel" )
                     :value 0 :action #'(lambda () 
                             (send self :put-kernel-line-type))))
          #|  (kernel-width-values 
             (combine (list .100 .150 .200 .205 .375 .500 .625 .750 .875 )
                      (rseq 1 10 10) (^ (rseq 4 10 7) 2)))|#
            (kernel-width-values  
             (mapcar #'(lambda (x) 
                         (read-from-string (format () "~,3f" x)))
                     (apply 'rseq  (combine 0 
                                            (-   (second (send self :range (first (send self :current-variables))))
                                                 (first (send self :range (first (send self :current-variables)))))
                                                 100)))) ;PV new values for kernel smooth 
            (kernel-line (send toggle-item-proto :new 
                               "Kernel Smoother (Use Slider and Type)"
              :value (select smooth-fun-state 0)
              :action #'(lambda ()
                          (send self :kernel-line-type 
                                (send kernel-line-type :value))
                          (send self :switch-add-kernel-line))))
            (kernel-width (send text-item-proto :new "  1.000 "))
            (kernel-width-scrollbar (send sequence-scroll-item-proto :new
                kernel-width-values
                :value 8
                :action #'(lambda (value)
                   (send graph :put-kernel-width-value)
                   (when (send self :add-kernel-line)
                         (send self :start-buffering)
                         (send self :switch-add-kernel-line)
                         (send self :switch-add-kernel-line)
                         (send self :buffer-to-screen)))
                :text-item kernel-width))
            (lowess-fraction (send text-item-proto :new ".300 "))
            (lowess-fraction-scrollbar (send sequence-scroll-item-proto :new
                (rseq 0 1 41) :value 12 :page-increment 2 
                :action #'(lambda (value) 
                  (send graph :lowess-fraction value)
                  (when (send self :add-lowess)
                        (send self :start-buffering)
                        (send self :switch-add-lowess)
                        (send self :switch-add-lowess)
                        (send self :buffer-to-screen))
                       (when (send self :add-lowcolorlines?)
                        (send self :start-buffering)
                        (send self :switch-add-lowcolor)
                        (send self :switch-add-lowcolor)
                        (send self :buffer-to-screen)
                             )
                            )
                 :text-item lowess-fraction))
            (lowess (send toggle-item-proto :new 
                          "Lowess Smoother (Use Slider)"
              :value (select smooth-fun-state 0)
              :action #'(lambda ()
                 (send self :lowess-fraction
                       (read-from-string (send lowess-fraction :text)))
                 (setf (select smooth-fun-state 0) (not (select smooth-fun-state 0)))
                 (send self :switch-add-lowess))))
            (linear (send toggle-item-proto :new "Principal Axis"
               :value (select smooth-fun-state 1)
               :action #'(lambda () 
                  (setf (select smooth-fun-state 1) (not (select smooth-fun-state 1)))
                  (send self :switch-add-linear))))
             (regcolor (send toggle-item-proto :new "Regression lines Colors"
               :value (select smooth-fun-state 1)
               :action #'(lambda () 
                  (setf (select smooth-fun-state 1) (not (select smooth-fun-state 1)))
                  (send self :switch-add-regcolor))));PV
            (lowcolor (send toggle-item-proto :new "Lowess lines Colors (Use Slider)"
               :value (select smooth-fun-state 1)
               :action #'(lambda () 
                  (setf (select smooth-fun-state 1) (not (select smooth-fun-state 1)))
                  (send self :switch-add-lowcolor))));PV
            (lsmt (send toggle-item-proto :new "LS Monotone Line"
               :value (select smooth-fun-state 2)
               :action #'(lambda ()
                  (setf (select smooth-fun-state 2) (not (select smooth-fun-state 2)))
                  (send self :switch-add-lsmt))))
            (hilited-reg-lines  (send toggle-item-proto :new "Regression lines Selected "
               :value (select smooth-fun-state 1)
               :action #'(lambda ()
                  (setf (select smooth-fun-state 1) (not (select smooth-fun-state 1)))
                  (send self :switch-add-hilited-regression))))
            (spacer1 (send text-item-proto :new " "))
            (spacer2 (send text-item-proto :new " "))
            (spacer3 (send text-item-proto :new " "))
            (spacer4 (send text-item-proto :new " "))
            (dialog (send dialog-proto :new 
                        (list
                         linear 
                         regcolor 
                         hilited-reg-lines
                         lsmt
                         contours
                         (list spacer3 qt-slider qt-slider-value)
                         lowess
                         lowcolor
                         (list spacer2 lowess-fraction-scrollbar lowess-fraction)
                         kernel-line 
                         (list spacer4 kernel-width-scrollbar kernel-width)
                         (list spacer1 kernel-line-type)
                         )
                          :title "Control Panel"
                          :location (send graph :location)))
            )
       (defmeth self :put-kernel-line-type ()
         (send self :kernel-line-type (send kernel-line-type :value))
         (send self :kernel-width-value 
               (select kernel-width-values
                       (send kernel-width-scrollbar :value)))
         (when (send self :add-kernel-line)
               (send self :switch-add-kernel-line)
               (send self :switch-add-kernel-line)))
       (defmeth self :put-kernel-width-value ()
         (send self :kernel-width-value 
               (select kernel-width-values
                       (send kernel-width-scrollbar :value)))
         (send self :kernel-line-type (send kernel-line-type :value))
         (when (send self :add-kernel-line)
               (send self :switch-add-kernel-line)
               (send self :switch-add-kernel-line)))
     ;  (defmeth self :do-addnorm ()
     ;   (when (send quantour :value)
     ;         (send quantour :value nil)
     ;         (send self :switch-add-quantile))
     ;   (send self :switch-add-normal))
     ;  (defmeth self :do-addquant ()
     ;    (when (send normal :value)
     ;          (send normal :value nil)
     ;          (send self :switch-add-normal))
     ;    (send self :switch-add-quantile))
       (defmeth scatterplot-proto :add-contours ()
         (case (send contours :value)
           (0 (when (send quantour :value)
                    (send quantour :value nil)
                    (send self :switch-add-quantile))
              (when (send normal :value)
                    (send normal :value nil)
                    (send self :switch-add-normal))
              )
           (1 (when (send quantour :value)
                    (send quantour :value nil)
                    (send self :switch-add-quantile))
              (unless (send self :add-normal) 
                      (send self :switch-add-normal)
                      (send normal :value t))
              )
           (2 (when (send normal :value)
                    (send normal :value nil)
                    (send self :switch-add-normal))
              (unless (send self :add-quantile)
                      (send self :switch-add-quantile)
                      (send quantour :value t))
              )
           ))
       (send lowess-fraction-scrollbar :value 12)
       (send qt-slider :value 15)
       (send self :add-subordinate dialog)
       (send self :slot-value 'dens-dialog dialog)
       (send kernel-width-scrollbar :value 9)
      ;(break)
       ))
      (t (send (send self :slot-value 'dens-dialog) :show-window))
      
      ))
